SuperStrict

Framework BRL.GLMax2D
Import BRL.PngLoader
Import BRL.Standardio
Import Pub.GLEW
Import BRL.Random
SetGraphicsDriver GLMax2DDriver()
Global xres#=800
Global yres#=600
Graphics xres,yres,0,0,2


'SetMaskColor(255,255,255)
SetMaskColor(0,0,0)
'Global texParticle:Int = GLTexFromPixmap( LoadPixmapPNG("metaball.png") )


local pixmap:TPixmap = createpixmap(64,64,PF_RGBA8888)
drawCircleFill(pixmap)
Global texParticle:Int = GLTexFromPixmap(pixmap)

global boat:waterparticle[400]
global boatParticles:int = 0
loadBoat()
global boatpx# = 0
global boatpy# = 0
global boatvx# = 0
global boatvy# = 0
global boatax# = 0
global boatay# = 0



Type vec2
	Field x:float,y:float

	Function Create:vec2(x:float,y:float)
	  Local tmp:vec2 = New vec2
	  tmp.x = x; tmp.y = y;
	  Return tmp
	End Function
	
	method set(x#,y#)
		self.x=x
		self.y=y
	End method 

	method normalize()
		local length# = sqr(x*x+y*y)
		x:/length
		y:/length
	end method
	
	method mult(s#)
		x:*s
		y:*s
	end method

	function lerp:vec2(a:vec2, b:vec2, t#)
		local tmp:vec2 = new vec2
		tmp.x = a.x + (b.x-a.x)*t
		tmp.y = a.y + (b.y-a.y)*t
		return tmp
	end function
End Type

type TBoat
	const MAX_PADDLE_SEGMENTS:int = 10
	field paddlePoint:vec2[MAX_PADDLE_SEGMENTS]
	
	method new()
		for local i:int = 0 until len(paddlePoint)
			paddlePoint[i] = vec2.Create(0,i)
		next
	end method
end type

global boat1:TBoat = new TBoat


Global water:waterparticle[] = New waterparticle[5000]
Global num_particles:Int = 0
Global radi# = 8

initPointSprite()

Local tim:Int = 0
Local oldtim:Int = 0
Global dt# = 0

Global e# = 0.7 'restitution

local oldmousx#
local oldmousy#
local mvx#
local mvy#

While Not KeyHit(KEY_ESCAPE)
	tim = MilliSecs()
	dt = (tim-oldtim) / 1000.0
	oldtim = tim


	'setblend LIGHTBLEND
	'setalpha .5
	
	glEnable(GL_TEXTURE_2D)
	glBindTexture(GL_TEXTURE_2D, texParticle)
	
	'SetBlend alphablend
	glEnable(GL_BLEND)
	glBlendFunc(GL_ONE, GL_ONE) 'Additive blending
	'glBlendFunc GL_SRC_ALPHA,GL_ONE
	'glDisable GL_ALPHA_TEST 'Important! GL turns this on for text methinks. 
	
	glPointSize radi*2'*4.0
	
	

	
	glBegin(GL_POINTS)
		glColor4f(0.1,0.2,0.8,.6)
		renderworld()
		
		glColor4f(0.5,0.2,0.1,1)
		drawboat()
	glEnd()
	
	
	glPointSize(1)
	
	Local first:waterparticle = water[0]
	
	mvx :* 0.98
	mvy :* 0.98
	
	mvx :+ (mousex()-oldmousx) * 0.25
	mvy :+ (mousey()-oldmousy) * 0.25

	If Mousedown(2)
	If first <> Null

		
		'first.vx = MouseX() - first.px
		'first.vy = MouseY() - first.py
		
		first.px = MouseX()
		first.py = MouseY()
		
		first.vx = mvx*1e3
		first.vy = mvy*1e3
		drawline(first.px, first.py, first.px+first.vx*50, first.py+first.vy*50)
	EndIf
	EndIf
	
	if keydown(KEY_LEFT) boatvx :- 100*dt
	if keydown(KEY_RIGHT) boatvx :+ 100*dt
	if keydown(KEY_UP) boatvy :- 100*dt
	if keydown(KEY_DOWN) boatvy :+ 100*dt
	
	dynamics()
	collisions()


	
	If MouseDown(3) And num_particles > 0 num_particles:-1
	
	If keyhit(key_space) And num_particles < Len(water)
		for local i:int = 0 until 50
		Local newParticle:waterparticle = New waterparticle
		newParticle.px = xres/2 + Rand(-2,2)
		newParticle.py = yres/2 + Rand(-2,2)

		
		newParticle.ay = 150
		
		water[num_particles] = newParticle
		num_particles:+1
		next
	EndIf
	
	SetAlpha 1
	SetColor 255,255,255
	SetBlend MASKBLEND
	DrawText "dt "+dt, 0, 15
	DrawText "# "+num_particles, 0, 15*2
	DrawText "# "+mvx, 0, 15*3
	DrawText "# "+mvy, 0, 15*4
	
	oldmousx = float( mousex() )
	oldmousy = float( mousey() )
	
	Flip
	Cls
	
	

Wend


Function renderworld()
	Local i:Int
	For i = 0 Until num_particles
		Local w:waterparticle = water[i]
		glVertex2f(w.px,w.py)
	Next
End Function

Function collisions()
	Local i:Int
	Local j:Int
	
	For i=0 Until num_particles
		Local a:waterparticle = water[i]
		For j=i+1 Until num_particles
			Local b:waterparticle = water[j]
			collide(a,b)
		Next
	Next
	
	
	For i=0 Until num_particles
		Local a:waterparticle = water[i]
		For j=0 Until boatParticles
			Local b:waterparticle = boat[j]
			local oldbx# = b.px
			local oldby# = b.py
			local depth# = collide(a,b)
			if depth <> 0
				if(b.py < a.py) 
					'boatvy :+ -5e-2
					boatvy :-depth*dt
				else
					'boatvy :+ 5e-2
					boatvy :+depth*dt
				endif
		
			endif
			b.px = oldbx
			b.py = oldby
			
		Next
	Next
End Function

function collide#(a:waterparticle,b:waterparticle)
			local collisionDepth# = 0
			Local dx# = (b.px - a.px)
			Local dy# = (b.py - a.py)
			Local distSq# = dx*dx+dy*dy
			
			Local vxa# = 0.0; Local vya# = 0.0
			Local vxb# = 0.0; Local vyb# = 0.0
			
			If distSq < radi*radi*4 'all balls same size. 2 balls intersect
				Local dist# = Sqr(distSq)
				vxa = a.vx; vya = a.vy;
				vxb = b.vx; vyb = b.vy;
				Local nx# = b.px - a.px
				Local ny# = b.py - a.py
				
				If Abs(dist) > 1e-7
					
				
					'Collision direction
					Local cdx# = nx / dist
					Local cdy# = ny / dist
					'displacement distance
					Local dd# = 2*radi-dist
					collisionDepth=dd
					a.px :- dd*cdx
					a.py :- dd*cdy
					b.px :+ dd*cdx
					b.py :+ dd*cdy
					
					'a.ax :- dd*cdx*.75
					'a.ay :- dd*cdy*.75
					'b.ax :+ dd*cdx*.75
					'b.ay :+ dd*cdy*.75
					Local am# = Sqr( a.vx*a.vx + a.vy*a.vy )
					
					If Abs(am) > 1e-7
						'dot prod mult by restitution
						Local cosam# = cdx * a.vx + cdy * a.vy * e
						vxa :- cdx*cosam
						vya :- cdy*cosam
						vxb :+ cdx*cosam
						vyb :+ cdy*cosam
					EndIf
					
					Local bm# = Sqr( b.vx*b.vx + b.vy*b.vy )
					
					If Abs(bm) > 1e-7
						'dot prod mult by restitution
						Local cosam# = cdx * b.vx + cdy * b.vy * e
						vxa :+ cdx*cosam
						vya :+ cdy*cosam
						vxb :- cdx*cosam
						vyb :- cdy*cosam
					EndIf
					
				EndIf
					
				a.vx = vxa
				a.vy = vya
				b.vx = vxb
				b.vy = vyb
				
				
				
			EndIf

	return collisionDepth
end function

Function dynamics()

	
	'Dynamics
	'incompressible. chrystal-like behaviour. "stolen" from paul bourkes site.
	Local i:Int
	For i=0 Until num_particles
		Local w:waterparticle = water[i]
		'verlet integration
		Local tempx# = w.ax*dt
		w.px = w.px + dt*(w.vx+tempx*.5)
		w.vx = w.vx + tempx

		Local tempy# = w.ay*dt
		w.py = w.py + dt*(w.vy+tempy*.5)
		w.vy = w.vy + tempy
		
		w.ax = 0
		w.ay = 100
		
		'Boundary conditions
		If w.px < w.r 
			w.px = w.r 
			w.vx = -w.vx' * e
		EndIf
		
		If w.py < w.r 
			w.py = w.r 
			w.vy = -w.vy' * e
		EndIf
		
		If w.px > xres-w.r
			w.px = xres-w.r 
			w.vx = -w.vx' * e
		EndIf
		
		If w.py > yres-w.r 
			w.py = yres-w.r	 
			w.vy = -w.vy' * e
		EndIf
	Next

	
End Function

Function dist2D:Float(x1#,y1#,x2#,y2#)
	Return Sqr( (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2) )
End Function

Function distSquare:Float(x1#,y1#,x2#,y2#)
	Return (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)
End Function

Type waterparticle
	Field ox#, oy#
	Field px#, py#
	Field vx#, vy#
	Field ax#, ay#
	Field r# = radi
End Type


Function checkError()
	Local checkedAllErrors:Int = False
	Local glerrorList$ = ""
	Local numErrors:Int = 0
	While checkedAllErrors=False
		Local errorCode:Int = glGetError()
		If errorCode = GL_NO_ERROR
			checkedAllErrors = True
		Else
			numErrors = numErrors + 1
			If errorCode = GL_INVALID_ENUM glerrorList:+" invalid enum "
			If errorCode = GL_INVALID_VALUE glerrorList:+" invalid value "
			If errorCode = GL_INVALID_OPERATION glerrorList:+" invalid operation "
			If errorCode = GL_STACK_OVERFLOW glerrorList:+" stack overflow "
			If errorCode = GL_STACK_UNDERFLOW glerrorList:+" stack underflow "
			If errorCode = GL_OUT_OF_MEMORY glerrorList:+" GL_OUT_OF_MEMORY "
			If errorCode = GL_TABLE_TOO_LARGE glerrorList:+" GL_TABLE_TOO_LARGE "
		EndIf
	Wend
	If glerrorList <> ""
		Print "#"+numErrors +" glGetErrors this frame: "+glerrorList
	EndIf
End Function

Function initPointSprite()
'Glew, opengl extension wrangler is used To se If an extension is supported.
	glewInit()	
	If(GL_POINT_SPRITE)
		Print "GL_POINT_SPRITE is supported"
		glEnable(GL_POINT_SPRITE)
	Else 
		Print "GL_POINT_SPRITE is Not supported"
		End
	EndIf
	'glEnable( GL_BLEND )
	'glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA ) 'additive without overblending
	'glPointSize( 30.0 )
	
	glActiveTexture(GL_TEXTURE0);
	glEnable( GL_TEXTURE_2D );
	glTexEnvi(GL_POINT_SPRITE, GL_COORD_REPLACE, GL_TRUE); 'Generates tex coords for Point Sprite
	'modes: <a href="http://www.khronos.org/opengles/documentation/opengles1_0/html/glTexEnv.html" target="_blank">http://www.khronos.org/opengles/documentation/opengles1_0/html/glTexEnv.html</a>
	glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  'GL_MODULATE, GL_DECAL, GL_BLEND, Or GL_REPLACE.
	
	'Local color:Float[] = [1.0, 0.0, 0.0]
	'glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, color[0] )
	'glBindTexture(GL_TEXTURE_2D, texture_name);
End Function

Function drawCircleFill(px:TPixmap)
	Local siz:Float = px.width
	Local center:Float = (siz-1) / 2.0
   	For Local y:Int=0 Until siz
   	For Local x:Int=0 Until siz

		Local a:Int = 255	
		Local c:Int = 0
		local cx# = x-center
		local cy# = y-center
		if sqr(cx*cx+cy*cy) < siz/2 then c = 255
		Local argb:Int = ( a Shl 24) + c Shl 16 + c Shl 8 + c
		WritePixel px,x,y,argb      	
   	Next
	Next 
End Function


function loadBoat()
	local imgBoat:tpixmap = loadpixmap("boat.png")
	local i:int
	local j:int
	for i=0 until imgBoat.width
	for j=0 until imgBoat.height
		local pixel:int = imgBoat.readpixel(i,j)
		local a:int, r:int, g:int, b:int
		unpackARGB(pixel,a,r,g,b)
		if r = 0
			assert boatParticles<len(boat), "boat consists of too many pixels. must be less than " + len(boat)
			
			boat[boatParticles] = new waterparticle
			boat[boatParticles].px = i*radi
			boat[boatParticles].py = j*radi
			boatParticles:+1
		endif
	next
	next
	
	print boatParticles
end function

function drawboat()
	boatvx :+ boatax*dt
	boatvy :+ boatvy*dt
	boatpx :+ boatvx*dt
	boatpy :+ boatvy*dt
	boatax = 0
	boatay = 1
	boatvx :*0.5
	boatvy :*0.5
	
	local deltatx# = boatpx
	local deltaty# = boatpy
	if mousedown(1)
		boatpx = mousex()
		boatpy = mousey()
		deltatx = (boatpx - 25*radi) - boat[0].px
		deltaty = (boatpy + 5*radi) - boat[0].py
		boatax = 0
		boatay = 0
		boatvx = 0
		boatvy = 0
	endif
	

	
	local i:int
	for i=0 until boatParticles

		boat[i].px :+ deltatx
		boat[i].py :+ deltaty
		
		glVertex2f( boat[i].px, boat[i].py )
	next
	
	

	
end function

function unpackARGB(argb:int, a% var, r% var, g% var, b% var)
	a = argb shr 24 & $ff
	r = (argb shr 16) & $ff
	g = (argb shr 8) & $ff
	b = argb & $ff
end function


'im guessing its bresenham. prolly overkill.
'taken from the evaldraw example blockscan.kc
'converted to BMax.
Function blockscan(x0#,y0#,x1#,y1#,blocksiz#)
	local pointplots:int = 0
   'Scale down to blocky pixels
   x0 :/ blocksiz
   y0 :/ blocksiz
   x1 :/ blocksiz
   y1 :/ blocksiz
   Local prec# = 65536.0 '// 2^16
   Local ix:Int = Floor(x0);
   Local ix1:Int = Floor(x1)-ix;
   Local ixi:Int = (ix1>0)*2-1;
   Local iy:Int = Floor(y0);
   Local iy1:Int = Floor(y1)-iy;
   Local iyi:Int = (iy1>0)*2-1;
   Local fx# = x0-ix;
   If (ixi > 0) fx = 1-fx;
   Local  fy# = y0-iy;
   If (iyi > 0) fy = 1-fy;
   Local gx# = Abs(x1-x0)*prec;
   Local idx:Int = Int(gx);
   Local gy# = Abs(y1-y0)*prec;
   Local idy:Int = Int(gy);

   Local id:Int;
   If (ix1 = 0) Then 
	id = -1; idx = 0;
   Else If (iy1 = 0)
	id =  0; idy = 0;
   Else
	id = Int(fy*gx - fx*gy);
   EndIf
   For Local c:Int=Abs(ix1)+Abs(iy1) Until 0 Step -1
	pointplots :+1
	'glVertex2f( ix*blocksiz , iy*blocksiz ) 'scale up to screen pixels
	if pointplots < len(boat1.paddlePoint)
		boat1.paddlePoint[pointplots].x = ix*blockSiz
		boat1.paddlePoint[pointplots].y = iy*blockSiz
	endif

      If (id >= 0)
		ix :+ ixi; id :- idy;
      Else 
		iy :+ iyi; id :+ idx; 
	EndIf
   Next
End Function

